;; The first four lines of this file were added by Dracula.
;; They tell DrScheme that this is a Dracula Modular ACL2 program.
;; Leave these lines unchanged so that DrScheme can properly load this file.
#reader(planet "reader.rkt" ("cce" "dracula.plt") "modular" "lang")
(require "igenerate.lisp")
(require "ioverlay.lisp")
(require "icommon.lisp")
(require "iimage.lisp")

(module MOverlay
  (import IImage)
  (import ICommon)
  (import IGenerate)
  
  
  (defun IsSubKeyword(mode)
    (or (string-equal mode "SUB") (string-equal mode "S") (string-equal mode "SUBTRACT")))
 
  (defun IsInvSubKeyword(mode)
     (or (string-equal mode "INVSUB") (string-equal mode "IS") (string-equal mode "INVERSESUBTRACT")))
  
  (defun IsAddKeyword(mode)
     (or (string-equal mode "ADD") (string-equal mode "A")))
 
  (defun IsInvAddKeyword(mode)
     (or (string-equal mode "INVADD") (string-equal mode "IA") (string-equal mode "INVERSEADD")))
  
  (defun IsMulKeyword(mode)
     (or (string-equal mode "MUL") (string-equal mode "M") (string-equal mode "MULTIPLY")))
  
  (defun IsInvMulKeyword(mode)
     (or (string-equal mode "INVMUL") (string-equal mode "IM") (string-equal mode "INVERSEMULTIPLY")))
  
  (defun IsBlendKeyword(mode)
     (or (string-equal mode "BLE") (string-equal mode "B") (string-equal mode "BLEND")))
  
  (defun IsInvBlendKeyword(mode)
     (or (string-equal mode "INVBLE") (string-equal mode "IB") (string-equal mode "INVERSEBLEND")))
  
  
  (defun IsValidMode(mode)
    (or (IsSubKeyword mode) (IsInvSubKeyword mode) (IsAddKeyword mode) (IsInvAddKeyword mode)
        (IsMulKeyword mode) (IsInvMulKeyword mode) (IsBlendKeyword mode) (IsInvBlendKeyword mode)))  
  
  (defun BlendColor(color1 color2)
    (let* ((ratio (/ color2 255)))
      (cap (round (* color1 ratio) 1) 0 255)))
  
  (defun SubtractColor (color1 color2)
    (cap (- color1 color2) 0 255))
  
  (defun AddColor (color1 color2)
    (cap (+ color1 color2) 0 255))
  
  (defun MultiplyColor (color1 color2)
    (cap (* color1 color2) 0 255))
  
  
  
  (defun MergeColor(color1 color2 mode)
    (cond 
      ((IsSubKeyword mode)      (SubtractColor color1 color2))
      ((IsInvSubKeyword mode)   (SubtractColor color1 (- 255 color2)))
      ((IsAddKeyword mode)      (AddColor color1 color2))
      ((IsInvAddKeyword mode)   (AddColor color1 color2))
      ((IsMulKeyword mode)      (MultiplyColor color1 color2))
      ((IsInvMulKeyword mode)   (MultiplyColor color1 (- 255 color2)))
      ((IsBlendKeyword mode)    (BlendColor color1 color2))
      ((IsInvBlendKeyword mode) (BlendColor color1 (- 255 color2)))))
      
      
  
  (defun MergePixels(pixel1 pixel2 mode)
    (let* ((red1   (car pixel1))
           (green1 (cadr pixel1))
           (blue1  (caddr pixel1))
           (red2   (car pixel2))
           (green2 (cadr pixel2))
           (blue2  (caddr pixel2)))
      (list (MergeColor red1 red2 mode) (MergeColor green1 green2 mode) (MergeColor blue1 blue2 mode))))
      
    
  (defun OverlayPixel(tree1 tree2 x y width height mode)
    (if (isValidPixel x y width height)
        (let* ((nextX         (getNextXCoordinate x width))
               (nextY         (getNextYCoordinate x y width))
               (originalPixel (getPixel tree1 x y))
               (genPixel      (getPixel tree2 x y))
               (newPixel      (MergePixels originalPixel genPixel mode))
               (newR          (car newPixel))
               (newG          (cadr newPixel))
               (newB          (caddr newPixel)))
            (OverlayPixel (insertPixel tree1 x y newR newG newB) tree2 nextX nextY width height mode))
        tree1))
                      
  (defun Overlay(tree1 tree2 mode)
    (let* ((width  (getWidth tree1))
           (height (getHeight tree2)))
    (OverlayPixel tree1 tree2 1 height width height mode)))
    
    
    
  (defun MainOverlay(tree args)
    (let* ((mode (getLastElement args)))
      (mv-let (genTree genLog)
              (MainGenerate tree args)
              (if (IsValidMode mode)
                  (mv (Overlay tree genTree mode) (append genLog (list "--Sucessfully used to overlay image.")))
                  (mv tree (append genLog (list "--Invalid overlay mode.")))))))

  (export IOverlay))
  